明治維新は、まずは西欧から「学ぶ」ことに特化したのである。
#remotes::install_git("https://gitee.com/JohnCoene/echarts4r")
lib('echarts4r')## 载入需要的程辑包:echarts4r
echarts4r TRUE
mtcars |>
e_charts(disp) |>
e_scatter(mpg, qsec) |>
e_loess(mpg ~ disp)iris |>
group_by(Species) |>
e_charts(Sepal.Length) |>
e_line(Sepal.Width) |>
e_lm(Sepal.Width ~ Sepal.Length) |>
e_x_axis(min = 4)df <- data.frame(
x = seq(50),
y = rnorm(50, 10, 3),
z = rnorm(50, 11, 2),
w = rnorm(50, 9, 2)
)
df |>
e_charts(x) |>
e_line(z) |>
e_area(w) |>
e_title("Line and area charts")df |>
e_charts(x) |>
e_polar() |>
e_angle_axis(x) |> # angle = x
e_radius_axis() |>
e_bar(y, coord_system = "polar") |>
e_scatter(z, coord_system = "polar")df |>
head(10) |>
e_charts(x) |>
e_polar() |>
e_angle_axis() |>
e_radius_axis(x) |>
e_bar(y, coord_system = "polar") |>
e_scatter(z, coord_system = "polar")df <- data.frame(
x = LETTERS[1:5],
y = runif(5, 1, 5),
z = runif(5, 3, 7)
)
df |>
e_charts(x) |>
e_radar(y, max = 7, name = "radar") |>
e_radar(z, max = 7, name = "chart") |>
e_tooltip(trigger = "item")| 序列 | 技能 | 程度 |
|---|---|---|
| 1 | 计量经济学 | 9 |
| 2 | 量化交易 | 9 |
| 3 | ®编程 | 9 |
| 4 | 微软办公软件 | 8 |
| 5 | SQL语言 | 3 |
| 6 | 派森编程语言 | 4 |
| 7 | 数据分析 | 9 |
| 8 | 客服工作 | 9 |
| 9 | 体育博彩行业 | 7 |
| 10 | 建立®Studio服务器 | 7 |
| 11 | 统计学 | 6 |
| 12 | 数据科学 | 8 |
| 13 | 闪霓应用 | 8 |
| 14 | 李呢克斯🐧操作系统 | 7 |
| 15 | 网页应用程序接口 | 6 |
| 16 | Sparklyr大数据分析 | 2 |
| 17 | 量化分析 | 8 |
| 18 | 高级®编程 | 6 |
| 19 | modeltime / tidyverts / prophet | 7 |
| 20 | tidyverse / tidymodels | 6 |
| 21 | 张量Tensorflow / Pytorch | 2 |
| 22 | 浏览器驱动 | 4 |
| 23 | FrontPage / 部署网站 | 3 |
| 24 | Photoshop / Picsart | 5 |
# Library
library(fmsb)
# Create data: note in High school for Jonathan:
data <- as.data.frame(matrix( sample( 2:20 , 10 , replace=T) , ncol=10))
colnames(data) <- c("math" , "english" , "biology" , "music" , "R-coding", "data-viz" , "french" , "physic", "statistic", "sport" )
# To use the fmsb package, I have to add 2 lines to the dataframe: the max and min of each topic to show on the plot!
data <- rbind(rep(20,10) , rep(0,10) , data)
# Check your data, it has to look like this!
# head(data)
# The default radar chart
radarchart(data)# Library
library(fmsb)
# Create data: note in High school for Jonathan:
data <- as.data.frame(matrix( sample( 2:20 , 10 , replace=T) , ncol=10))
colnames(data) <- c("math" , "english" , "biology" , "music" , "R-coding", "data-viz" , "french" , "physic", "statistic", "sport" )
# To use the fmsb package, I have to add 2 lines to the dataframe: the max and min of each topic to show on the plot!
data <- rbind(rep(20,10) , rep(0,10) , data)
# Check your data, it has to look like this!
# head(data)
# Custom the radarChart !
radarchart( data , axistype=1 ,
#custom polygon
pcol=rgb(0.2,0.5,0.5,0.9) , pfcol=rgb(0.2,0.5,0.5,0.5) , plwd=4 ,
#custom the grid
cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(0,20,5), cglwd=0.8,
#custom labels
vlcex=0.8
)library(radarchart)
labs <- c("Communicator", "Data Wangler", "Programmer",
"Technologist", "Modeller", "Visualizer")
scores <- list(
"Rich" = c(9, 7, 4, 5, 3, 7),
"Andy" = c(7, 6, 6, 2, 6, 9),
"Aimee" = c(6, 5, 8, 4, 7, 6)
)
chartJSRadar(scores = scores, labs = labs, maxScale = 10)scores <- data.frame("Label"=c("Communicator", "Data Wangler", "Programmer",
"Technologist", "Modeller", "Visualizer"),
"Rich" = c(9, 7, 4, 5, 3, 7),
"Andy" = c(7, 6, 6, 2, 6, 9),
"Aimee" = c(6, 5, 8, 4, 7, 6))
chartJSRadar(scores, maxScale = 10, showToolTipLabel=TRUE)chartJSRadar(skills, main = "Data Science Radar")chartJSRadarOutput("ID", width = "450", height = "300")#runExampleApp("basic")lib('fmsb', 'scales')## 载入需要的程辑包:scales
##
## 载入程辑包:'scales'
## The following objects are masked from 'package:formattable':
##
## comma, percent, scientific
## The following object is masked from 'package:purrr':
##
## discard
## The following object is masked from 'package:readr':
##
## col_factor
fmsb scales TRUE TRUE
lib(c('ggradar', 'rescale', 'lattice', 'rgl', 'akima', 'metan'))## 载入需要的程辑包:ggradar
## 载入需要的程辑包:rescale
##
## 载入程辑包:'rescale'
## The following object is masked from 'package:scales':
##
## rescale
## 载入需要的程辑包:lattice
## 载入需要的程辑包:rgl
## 载入需要的程辑包:akima
## 载入需要的程辑包:metan
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
## |=========================================================|
## | Multi-Environment Trial Analysis (metan) v1.16.0 |
## | Author: Tiago Olivoto |
## | Type 'citation('metan')' to know how to cite metan |
## | Type 'vignette('metan_start')' for a short tutorial |
## | Visit 'https://bit.ly/pkgmetan' for a complete tutorial |
## |=========================================================|
##
## 载入程辑包:'metan'
## The following object is masked from 'package:magrittr':
##
## set_class
## The following object is masked from 'package:MASS':
##
## select
## The following object is masked from 'package:forcats':
##
## as_factor
## The following object is masked from 'package:dplyr':
##
## recode_factor
## The following object is masked from 'package:tidyr':
##
## replace_na
## The following objects are masked from 'package:tibble':
##
## column_to_rownames, remove_rownames, rownames_to_column
ggradar rescale lattice rgl akima metan TRUE TRUE TRUE TRUE TRUE TRUE
df_maxmin <- data.frame(
drat = c(1, 0),
wt = c(1, 0),
qsec = c(1, 0),
vs = c(1, 0),
am = c(1, 0))
#load data
mtcars_radar <- mtcars %>%
as_tibble(rownames = "group") %>%
mutate_at(vars(-group), rescale) %>%
tail(2) %>%
dplyr::select(1,6:10)## Error in `mutate()`:
## ! Problem while computing `mpg = (function (data, data2 = data, center =
## character(0), scale = character(0)) ...`.
## Caused by error in `err()`:
## ! `data` must be a data.frame.
#check data type with std() function
str(mtcars_radar)## Error in str(mtcars_radar): 找不到对象'mtcars_radar'
mtcars_radar <- mtcars_radar[,c('drat','wt','qsec','vs','am')]## Error in eval(expr, envir, enclos): 找不到对象'mtcars_radar'
mtcars_radar <- rbind(df_maxmin, mtcars_radar)## Error in rbind(deparse.level, ...): 找不到对象'mtcars_radar'
fmsb::radarchart(mtcars_radar)## Error in is.data.frame(df): 找不到对象'mtcars_radar'
#devtools::install_github('ricardo-bion/ggradar', dependencies = TRUE, force = T)
#devtools::install_github("poissonconsulting/rescale")
lib(c('ggradar', 'rescale', 'lattice', 'rgl', 'akima', 'metan'))ggradar rescale lattice rgl akima metan TRUE TRUE TRUE TRUE TRUE TRUE
x=runif(1000)
y=runif(1000)
z=rnorm(1000)
s=interp(x,y,z,duplicate="strip")
surface3d(s$x,s$y,s$z,color="blue")
points3d(s)
x <- seq(-10, 10, length.out = 50)
y <- x
rotsinc <- function(x,y) {
sinc <- function(x) { y <- sin(x)/x ; y[is.na(y)] <- 1; y }
10 * sinc( sqrt(x^2+y^2) )
}
z <- outer(x, y, rotsinc)
persp(x, y, z)surface3d(x, y, z)
# begin generating my 3D shape
b <- seq(from=0, to=20,by=0.5)
s <- seq(from=0, to=20,by=0.5)
payoff <- expand.grid(b=b,s=s)
payoff$payoff <- payoff$b - payoff$s
payoff$payoff[payoff$payoff < -1] <- -1
# end generating my 3D shape
wireframe(payoff ~ s * b, payoff, shade = TRUE, aspect = c(1, 1),
light.source = c(10,10,10), main = "Study 1",
scales = list(z.ticks=5,arrows=FALSE, col="black", font=10, tck=0.5),
screen = list(z = 40, x = -75, y = 0))plot_rgl_model_a <- function(fdata, plot_contour = T, plot_points = T,
verbose = F, colour = "rainbow", smoother = F){
## takes a model in long form, in the format
## 1st column x
## 2nd is y,
## 3rd is z (height)
## and draws an rgl model
## includes a contour plot below and plots the points in blue
## if these are set to TRUE
# note that x has to be ascending, followed by y
if (verbose) print(head(fdata))
fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]
if (verbose) print(head(fdata))
##
require(reshape2)
require(rgl)
orig_names <- colnames(fdata)
colnames(fdata) <- c("x", "y", "z")
fdata <- as.data.frame(fdata)
## work out the min and max of x,y,z
xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
l <- list (x = xlimits, y = ylimits, z = zlimits)
xyz <- do.call(expand.grid, l)
if (verbose) print(xyz)
x_boundaries <- xyz$x
if (verbose) print(class(xyz$x))
y_boundaries <- xyz$y
if (verbose) print(class(xyz$y))
z_boundaries <- xyz$z
if (verbose) print(class(xyz$z))
if (verbose) print(paste(x_boundaries, y_boundaries, z_boundaries, sep = ";"))
# now turn fdata into a wide format for use with the rgl.surface
fdata[, 2] <- as.character(fdata[, 2])
fdata[, 3] <- as.character(fdata[, 3])
#if (verbose) print(class(fdata[, 2]))
wide_form <- dcast(fdata, y ~ x, value_var = "z")
if (verbose) print(head(wide_form))
wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])
if (verbose) print(wide_form_values)
x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
y_values <- as.numeric(wide_form[, 1])
if (verbose) print(x_values)
if (verbose) print(y_values)
wide_form_values <- wide_form_values[order(y_values), order(x_values)]
wide_form_values <- as.numeric(wide_form_values)
x_values <- x_values[order(x_values)]
y_values <- y_values[order(y_values)]
if (verbose) print(x_values)
if (verbose) print(y_values)
if (verbose) print(dim(wide_form_values))
if (verbose) print(length(x_values))
if (verbose) print(length(y_values))
zlim <- range(wide_form_values)
if (verbose) print(zlim)
zlen <- zlim[2] - zlim[1] + 1
if (verbose) print(zlen)
if (colour == "rainbow"){
colourut <- rainbow(zlen, alpha = 0)
if (verbose) print(colourut)
col <- colourut[ wide_form_values - zlim[1] + 1]
# if (verbose) print(col)
} else {
col <- "grey"
if (verbose) print(table(col2))
}
open3d()
plot3d(x_boundaries, y_boundaries, z_boundaries,
box = T, col = "black", xlab = orig_names[1],
ylab = orig_names[2], zlab = orig_names[3])
rgl.surface(z = x_values, ## these are all different because
x = y_values, ## of the confusing way that
y = wide_form_values, ## rgl.surface works! - y is the height!
coords = c(2,3,1),
color = col,
alpha = 1.0,
lit = F,
smooth = smoother)
if (plot_points){
# plot points in red just to be on the safe side!
points3d(fdata, col = "blue")
}
if (plot_contour){
# plot the plane underneath
flat_matrix <- wide_form_values
if (verbose) print(flat_matrix)
y_intercept <- (zlim[2] - zlim[1]) * (-2/3) # put the flat matrix 1/2 the distance below the lower height
flat_matrix[which(flat_matrix != y_intercept)] <- y_intercept
if (verbose) print(flat_matrix)
rgl.surface(z = x_values, ## these are all different because
x = y_values, ## of the confusing way that
y = flat_matrix, ## rgl.surface works! - y is the height!
coords = c(2,3,1),
color = col,
alpha = 1.0,
smooth = smoother)
}
}
add_rgl_model <- function(fdata){
## takes a model in long form, in the format
## 1st column x
## 2nd is y,
## 3rd is z (height)
## and draws an rgl model
##
# note that x has to be ascending, followed by y
print(head(fdata))
fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]
print(head(fdata))
##
require(reshape2)
require(rgl)
orig_names <- colnames(fdata)
#print(head(fdata))
colnames(fdata) <- c("x", "y", "z")
fdata <- as.data.frame(fdata)
## work out the min and max of x,y,z
xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
l <- list (x = xlimits, y = ylimits, z = zlimits)
xyz <- do.call(expand.grid, l)
#print(xyz)
x_boundaries <- xyz$x
#print(class(xyz$x))
y_boundaries <- xyz$y
#print(class(xyz$y))
z_boundaries <- xyz$z
#print(class(xyz$z))
# now turn fdata into a wide format for use with the rgl.surface
fdata[, 2] <- as.character(fdata[, 2])
fdata[, 3] <- as.character(fdata[, 3])
#print(class(fdata[, 2]))
wide_form <- dcast(fdata, y ~ x, value_var = "z")
print(head(wide_form))
wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])
x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
y_values <- as.numeric(wide_form[, 1])
print(x_values)
print(y_values)
wide_form_values <- wide_form_values[order(y_values), order(x_values)]
x_values <- x_values[order(x_values)]
y_values <- y_values[order(y_values)]
print(x_values)
print(y_values)
print(dim(wide_form_values))
print(length(x_values))
print(length(y_values))
rgl.surface(z = x_values, ## these are all different because
x = y_values, ## of the confusing way that
y = wide_form_values, ## rgl.surface works!
coords = c(2,3,1),
alpha = .8)
# plot points in red just to be on the safe side!
points3d(fdata, col = "red")
}x=runif(1000)
y=runif(1000)
z=rnorm(1000)
s=interp(x,y,z,duplicate="strip")
surface3d(s$x,s$y,s$z,color="blue")
points3d(s)lib('ggplot2')ggplot2 TRUE
lib('rayshader')## 载入需要的程辑包:rayshader
rayshader TRUE
conflict_prefer("select", "dplyr")## [conflicted] Removing existing preference
## [conflicted] Will prefer dplyr::select over any other package
df <- data.frame(
YearMonth = c(202101L,202101L,202101L,
202102L,202102L,202102L,202103L,202103L,202103L),
Product = c("bike","car","skateboard",
"bike","car","skateboard","bike","car","skateboard"),
Sales = c(100L, 40L, 60L, 70L, 30L, 50L, 50L, 20L, 30L)
)
df <- rbind(df, subset(df, subset = Product == "bike"))
df$height <- match(df$YearMonth, sort(unique(df$YearMonth)))
dfYearMonth Product Sales height 1 202101 bike 100 1 2 202101 car 40 1 3 202101 skateboard 60 1 4 202102 bike 70 2 5 202102 car 30 2 6 202102 skateboard 50 2 7 202103 bike 50 3 8 202103 car 20 3 9 202103 skateboard 30 3 11 202101 bike 100 1 41 202102 bike 70 2 71 202103 bike 50 3
# Define a new coordinate system from coord_polar
coord_radar <- function(theta = "x", start = 0, direction = 1, clip = "on") {
theta <- match.arg(theta, c("x", "y"))
r <- if (theta == "x")
"y"
else "x"
ggproto(NULL, CoordPolar, theta = theta, r = r, start = start,
direction = sign(direction), clip = clip,
# This is the change to make the lines straight
is_linear = function() TRUE
)
}
plot2d <- ggplot(df, aes(x = Product, y = Sales, color = height)) +
geom_path(aes(group = YearMonth)) +
scale_color_continuous() +
guides(color = "none") +
coord_radar()
plot_gg(plot2d, raytrace = FALSE)library(tidyverse)
library(shiny)
library(plotly)
pokemons <-
read_table('
name hp defense attack sp_attack sp_defense speed
Bulbasaur 45 49 49 65 65 45
Ivysaur 60 63 62 80 80 60
Venusaur 80 123 100 122 120 80
Charmander 39 43 52 60 50 65
Charmeleon 58 58 64 80 65 80
Charizard 78 78 104 159 115 100')
ui <- navbarPage(title = "Pokemon Research",
tabPanel(title = "Pokemon Statistics",
sidebarPanel(
selectInput(inputId = "indv",
label = "Pokemon",
choices = pokemons$name,
selected = 'Bulbasaur')
),
mainPanel(
plotlyOutput('radar') #the radar plot
)
))
server <- function(input, output, session) {
output$radar <- renderPlotly({
pkmn <- filter(pokemons, name == input$indv)
r <- map_dbl(pkmn[, 2:6], ~.x)
nms <- names(r)
#code to plot the radar
fig <- plot_ly(
type = 'scatterpolar',
r = r,
theta = nms,
fill = 'toself',
mode = 'markers'
)
fig <- fig %>%
layout(
polar = list(
radialaxis = list(
visible = T,
range = c(0,max(r))
)
),
showlegend = F
)
})
}
shinyApp(ui, server)##
## Listening on http://127.0.0.1:8359
## https://codepen.io/duggi/pen/gPjrKM#_=_
## https://xiangyun.rbind.io/2021/11/interactive-web-graphics
lib('apexcharter')## 载入需要的程辑包:apexcharter
apexcharter TRUE
mtcars$model <- rownames(mtcars)
apex(data = head(mtcars), type = "radar", mapping = aes(x = model, y = qsec))# extremely complicated reshaping
new_mtcars <- reshape(
data = head(mtcars),
idvar = "model",
varying = list(c("drat", "wt")),
times = c("drat", "wt"),
direction = "long",
v.names = "value",
drop = c("mpg", "cyl", "hp", "dist", "qsec", "vs", "am", "gear", "carb")
)
apex(data = new_mtcars, type = "radar", mapping = aes(x = model, y = value, group = time))lib('JuliaCall')
julia_install_package_if_needed("Optim")
julia_installed_package("Optim")
#> [1] "0.22.0"
julia_library("Optim")我正在使用 echarts4r
创建一个圆环图.现在我正在尝试添加自定义工具提示,并且可以复制此处给出的示例
Echarts4r
: Create stacked area chart with percentage from total in tooltip
和这里 Displaying
extra variables in tooltips echarts4r
.但是,我不太明白这是如何扩展到饼图的。我想要一个带有工具提示的饼图,显示总数和相对百分比
library(tidyverse)
library(echarts4r)
My_df <- data.frame(n = c(1, 4, 10),
x = c("A", "B", " C")) %>%
mutate(percent = round(n/sum(n), 2) )
My_df %>%
e_charts(x) %>%
e_pie(n, radius = c("50%", "70%")) %>%
e_tooltip()这是我迄今为止最好的一次拍摄
My_df %>%
e_charts(x) %>%
e_pie(n, radius = c("50%", "70%")) %>%
e_tooltip(formatter = htmlwidgets::JS("
function(params){
return('<strong>' + params.name +
'</strong><br />total: ' + params.value +
'<br />percent: ' + params.value[1]) } "))在散点图示例中,使用 bind = 附加了额外的值。但这不适用于饼图。 最佳答案
你不能用params.percent ?
My_df %>%
e_charts(x) %>%
e_pie(n, radius = c("50%", "70%")) %>%
e_tooltip(formatter = htmlwidgets::JS("
function(params){
return('<strong>' + params.name +
'</strong><br />total: ' + params.value +
'<br />percent: ' + params.percent) +'%' } "))您也可以使用 Javascript template literals 整理一下。
My_df %>%
e_charts(x) %>%
e_pie(n, radius = c("50%", "70%")) %>%
e_tooltip(formatter = htmlwidgets::JS("
function(params)
{
return `<strong>${params.name}</strong>
<br/>Total: ${params.value}
<br/>Percent: ${params.percent}%`
} "))My_df %>%
e_charts(x) %>%
e_radar(n, radius = c("50%", "70%")) %>%
e_tooltip(formatter = htmlwidgets::JS("
function(params)
{
return `<strong>${params.name}</strong>
<br/>Total: ${params.value}
<br/>Percent: ${params.percent}%`
} "))